home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ansi / martin.zip / MARTIN.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-22  |  2KB  |  112 lines
  1. { Martin fractal program, by Alan Meiss
  2.  
  3.   Formula from "Dynamical Systems and Fractals",
  4.    by Karl-Heinz Becker and Michael Dörfler,
  5.    Cambridge University Press, 1990
  6.  
  7.   Written in Turbo Pascal 4.0, math chip recommended }
  8.  
  9. program martin_fractal;
  10.  
  11. uses graph, crt;
  12.  
  13. var xmax, ymax, t, tcmax, tc, clr, cx, cy, code:integer;
  14.     sa,sav,sb,sc:real;
  15.     ch:char;
  16.  
  17. { Check command line parameter for specified loop limit. }
  18.  
  19. procedure getparam;
  20.  
  21. begin
  22.    tcmax:=12;
  23.    if paramcount>0 then begin
  24.       val(paramstr(1),tcmax,code);
  25.       end;
  26.    tcmax:=abs(tcmax);
  27. end;
  28.  
  29. { Autodetect graphics hardware and initialize .bgi driver }
  30.  
  31. procedure init_graphics;
  32.  
  33. var aa,bb:integer;
  34.  
  35. begin
  36.    randomize;
  37.    detectgraph(aa,bb);
  38.    initgraph(aa,bb,'');
  39.    xmax:=getmaxx;
  40.    ymax:=getmaxy;
  41.    cx:=round(xmax/2.0);
  42.    cy:=round(ymax/2.0);
  43. end;
  44.  
  45. { Return sign of x: -1, 0, or +1 }
  46.  
  47. function sign(x:real):integer;
  48.  
  49. begin
  50.    sign:=0;
  51.    if x<>0 then begin
  52.       if x<0 then sign:=-1
  53.       else sign:=1;
  54.       end;
  55. end;
  56.  
  57. { Plot coordinate with real x,y values }
  58.  
  59. procedure plot(x,y:real;clr:integer);
  60.  
  61. begin
  62.    putpixel(round(x)+cx,round(y)+cy,clr);
  63. end;
  64.  
  65. { Cycle a given fractal until a key is pressed,
  66.    with a counter for incrementing display color.
  67.   "a", "b", and "c" are random values constant for a
  68.    given fractal, "s" is a scaling factor. }
  69.  
  70. procedure martin1(a,b,c,s:real);
  71.  
  72. var xold, yold, xnew, ynew:real;
  73.  
  74. begin
  75.    xold:=0;
  76.    yold:=0;
  77.    clr:=9+round(int(random*7));
  78.    t:=0;
  79.    tc:=0;
  80.    ch:='a';
  81.    repeat
  82.       plot(xold*s,yold*s,clr);
  83.       xnew:=yold-sign(xold)*sqrt(abs(b*xold-c)); { <- This is it! These two }
  84.       ynew:=a-xold;                              { <- lines generate the }
  85.       xold:=xnew;                                {     entire fractal! }
  86.       yold:=ynew;
  87.       inc(t);
  88.       if t>1000 then begin
  89.          inc(tc);
  90.          inc(clr);
  91.          if clr>15 then clr:=9;
  92.          t:=0;
  93.          end;
  94.    until keypressed or ((tc>(tcmax-1)) and (tcmax>0));
  95.    cleardevice;
  96.    if keypressed then ch:=readkey;
  97. end;
  98.  
  99. { Main loop. Cycle until ESC or Q is typed. }
  100.  
  101. begin
  102.    getparam;
  103.    init_graphics;
  104.    repeat
  105.       sa:=random*100.0-50.0;
  106.       sb:=random*100.0-50.0;
  107.       sc:=random*100.0-50.0;
  108.       sav:=(abs(sa)+abs(sb)+abs(sc))/3.0;
  109.       martin1(sa,sb,sc,6.0-abs(sav/10.0));
  110.    until (ord(ch)=27) or (ch='q') or (ch='Q');
  111.    textmode(3);
  112. end.